home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Languages / PowerMacOberon 1.2 / Source / Elems / ErrorElems.Mod (.txt) < prev    next >
Oberon Text  |  1995-08-22  |  8KB  |  205 lines
  1. Syntax10.Scn.Fnt
  2. Syntax10b.Scn.Fnt
  3. MODULE ErrorElems;    (** CAS 28-Oct-91 / MH 28-Sep-1993**)
  4.     IMPORT
  5.         Display, Input, Files, Fonts, Printer, Oberon, Texts, Viewers, MenuViewers, TextFrames, TextPrinter;
  6.     CONST
  7.         ErrFile = "OberonErrors.Text";
  8.         ErrFont = "Syntax8.Scn.Fnt";    (* MH: may be changed to any font *)
  9.         mm = TextFrames.mm;
  10.         CR = 0DX;
  11.         middleKey = 1; leftKey = 2;
  12.     TYPE
  13.         Elem* = POINTER TO ElemDesc;
  14.         ElemDesc* = RECORD(Texts.ElemDesc)
  15.             err*: INTEGER;
  16.             msg*: ARRAY 128 OF CHAR;
  17.             expanded: BOOLEAN;
  18.         END;
  19.         font*: Fonts.Font;
  20.         W: Texts.Writer;
  21.         lastTime: LONGINT;
  22.     PROCEDURE MarkedFrame (): TextFrames.Frame;
  23.         VAR V: Viewers.Viewer;
  24.     BEGIN V := Oberon.MarkedViewer();
  25.         IF (V IS MenuViewers.Viewer) & (V.dsc.next IS TextFrames.Frame) THEN RETURN V.dsc.next(TextFrames.Frame)
  26.         ELSE RETURN NIL
  27.         END
  28.     END MarkedFrame;
  29.     PROCEDURE Show (F: TextFrames.Frame; pos: LONGINT);
  30.         VAR beg, end, delta: LONGINT;
  31.     BEGIN delta := 200;
  32.         LOOP beg := F.org; end := TextFrames.Pos(F, F.X, F.Y);
  33.             IF (beg <= pos) & (pos < end) OR (beg = end) THEN EXIT END;
  34.             TextFrames.Show(F, pos - delta); DEC(delta, 20)
  35.         END
  36.     END Show;
  37.     PROCEDURE IntToStr (x: LONGINT; VAR s: ARRAY OF CHAR);
  38.         VAR i, j: INTEGER; str: ARRAY 10 OF CHAR;
  39.     BEGIN i := 0; j := 0;
  40.         REPEAT str[i] := CHR((x MOD 10) + ORD("0")); x := x DIV 10; INC(i) UNTIL x = 0;
  41.         REPEAT DEC(i); s[j] := str[i]; INC(j) UNTIL i = 0;
  42.         s[j] := 0X;
  43.     END IntToStr;
  44.     PROCEDURE Width (E: Elem): INTEGER;
  45.         VAR fnt: Fonts.Font; pat: Display.Pattern; i, px, dx, x, y, w, h: INTEGER;
  46.     BEGIN fnt := Fonts.This(ErrFont); i := 0; px := 0;
  47.         WHILE E.msg[i] # 0X DO
  48.             Display.GetChar(fnt.raster, E.msg[i], dx, x, y, w, h, pat); INC(px, dx); INC(i)
  49.         END;
  50.         RETURN px + 6
  51.     END Width;
  52.     PROCEDURE ShowErrMsg* (E: Elem; F: Display.Frame; col: SHORTINT; x0, y0, dw: INTEGER);
  53.         VAR fnt: Fonts.Font; pat: Display.Pattern; i, px, rm, dx, x, y, w, h: INTEGER; ch: CHAR;
  54.     BEGIN fnt := Fonts.This(ErrFont); i := 0; px := x0 + 3; rm := x0 + dw - 3;
  55.         LOOP ch := E.msg[i]; INC(i);
  56.             IF ch = 0X THEN EXIT END;
  57.             Display.GetChar(fnt.raster, ch, dx, x, y, w, h, pat);
  58.             IF px + dx > rm THEN EXIT END;
  59.             Display.CopyPattern(col, pat, px + x, y0 + y, Display.invert); INC(px, dx)
  60.         END
  61.     END ShowErrMsg;
  62.     PROCEDURE Expand* (E: Elem; pos: LONGINT);
  63.         VAR S: Texts.Scanner; T: Texts.Text; n, m: INTEGER; ch: CHAR;
  64.     BEGIN
  65.         NEW(T); Texts.Open(T, ErrFile); Texts.OpenScanner(S, T, 0);
  66.         REPEAT S.line := 0;
  67.             REPEAT Texts.Scan(S) UNTIL S.eot OR (S.line # 0)
  68.         UNTIL S.eot OR (S.class = Texts.Int) & (S.i = E.err);
  69.         IF ~S.eot THEN Texts.Read(S, ch); n := 0;
  70.             WHILE ~S.eot & (ch # CR) & (n + 1 < LEN(E.msg)) DO E.msg[n] := ch; INC(n); Texts.Read(S, ch) END;
  71.             E.msg[n] := 0X; E.W := LONG(Width(E)) * TextFrames.Unit;
  72.             TextFrames.NotifyDisplay(Texts.ElemBase(E), Texts.replace, pos, pos+1)
  73.         END;
  74.         E.expanded := TRUE;
  75.     END Expand;
  76.     PROCEDURE Reduce* (E: Elem; pos: LONGINT);
  77.     BEGIN
  78.         E.W := 3 * mm; IntToStr(E.err, E.msg); E.W := LONG(Width(E)) * TextFrames.Unit;
  79.         TextFrames.NotifyDisplay(Texts.ElemBase(E), Texts.replace, pos, pos+1);
  80.         E.expanded := FALSE;
  81.     END Reduce;
  82.     PROCEDURE Delete* (E: Elem; pos: LONGINT);
  83.         VAR T: Texts.Text;
  84.     BEGIN T := Texts.ElemBase(E);
  85.         IF T # NIL THEN Texts.Delete(T, pos, pos + 1) END
  86.     END Delete;
  87.     PROCEDURE Copy* (SE, DE: Elem);
  88.     BEGIN Texts.CopyElem(SE, DE); DE.err := SE.err; DE.msg := SE.msg; DE.expanded := SE.expanded;
  89.     END Copy;
  90.     PROCEDURE Prepare* (E: Elem; fnt: Fonts.Font; VAR voff: INTEGER);
  91.         VAR max: INTEGER;
  92.     BEGIN
  93.         IF font.height > fnt.height THEN max := font.height ELSE max := fnt.height END;
  94.         E.H := LONG(max+1) * TextFrames.Unit;
  95.         voff := fnt.minY;
  96.     END Prepare;
  97.     PROCEDURE Disp* (E: Elem; F: Display.Frame; col: SHORTINT; fnt: Fonts.Font; x0, y0: INTEGER);
  98.         VAR w, h: INTEGER;
  99.     BEGIN w := SHORT(E.W DIV TextFrames.Unit); h := SHORT(E.H DIV TextFrames.Unit);
  100.         Display.ReplConst(15, x0, y0 , w , h, Display.replace);
  101.         IF E.msg[0] # 0X THEN ShowErrMsg(E, F, col, x0, y0 - fnt.minY, w) END
  102.     END Disp;
  103.     PROCEDURE Print* (E: Elem; x0, y0: INTEGER);
  104.         VAR w, h: INTEGER;
  105.     BEGIN w := SHORT(E.W DIV TextPrinter.Unit); h := SHORT(E.H DIV TextPrinter.Unit);
  106.         Printer.ReplConst(x0 + 1, y0 + 2, w - 2, h)
  107.     END Print;
  108.     PROCEDURE Edit* (E: Elem; pos: LONGINT; x0, y0, x, y: INTEGER; keysum: SET);
  109.         VAR w, h: INTEGER; keys: SET;
  110.     BEGIN
  111.         IF keysum = {middleKey} THEN
  112.             w := SHORT(E.W DIV TextFrames.Unit); h := SHORT(E.H DIV TextFrames.Unit);
  113.             Oberon.RemoveMarks(x0, y0, w, h);
  114.             Display.ReplConst(15, x0 + 2 , y0 + 2, w - 4, h - 4, Display.invert);
  115.             REPEAT Input.Mouse(keys, x, y); keysum := keysum + keys;
  116.                 Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, x, y);
  117.             UNTIL keys = {};
  118.             Display.ReplConst(15, x0 + 2, y0 + 2, w - 4, h - 4, Display.invert);
  119.             IF keysum = {middleKey} THEN
  120.                 IF E.expanded THEN Reduce(E, pos) ELSE Expand(E, pos) END
  121.             END
  122.         END
  123.     END Edit;
  124.     PROCEDURE Handle* (E: Texts.Elem; VAR msg: Texts.ElemMsg);
  125.         VAR e: Elem; pos: LONGINT; w, h: INTEGER; keys, keysum: SET;
  126.     BEGIN
  127.         WITH E: Elem DO
  128.             IF msg IS TextFrames.DisplayMsg THEN
  129.                 WITH msg: TextFrames.DisplayMsg DO
  130.                     IF ~msg.prepare THEN Disp(E, msg.frame, msg.col, msg.fnt, msg.X0, msg.Y0)
  131.                     ELSE Prepare (E, msg.fnt, msg.Y0)
  132.                     END
  133.                 END
  134.             ELSIF msg IS TextPrinter.PrintMsg THEN
  135.                 WITH msg: TextPrinter.PrintMsg DO
  136.                     IF ~msg.prepare THEN Print(E, msg.X0, msg.Y0) END
  137.                 END
  138.             ELSIF msg IS Texts.CopyMsg THEN
  139.                 NEW(e); Copy(E, e); msg(Texts.CopyMsg).e := e;
  140.             ELSIF msg IS TextFrames.TrackMsg THEN
  141.                 WITH msg: TextFrames.TrackMsg DO
  142.                     Edit(E, msg.pos, msg.X0, msg.Y0, msg.X, msg.Y, msg.keys)
  143.                 END
  144.             END
  145.         END
  146.     END Handle;
  147.     PROCEDURE InsertAt* (T: Texts.Text; pos: LONGINT; err: INTEGER);
  148.         VAR e: Elem;
  149.     BEGIN NEW(e); e.H := LONG(font.height + 2) * TextFrames.Unit; e.handle := Handle;
  150.         e.err := err;
  151.         IntToStr(err, e.msg); e.W := LONG(Width(e)) * TextFrames.Unit; e.expanded := FALSE;
  152.         Texts.WriteElem(W, e); Texts.Insert(T, pos, W.buf)
  153.     END InsertAt;
  154.     PROCEDURE Unmark*;
  155.         VAR F: TextFrames.Frame; pos: LONGINT; R: Texts.Reader;
  156.     BEGIN F := MarkedFrame();
  157.         IF F # NIL THEN
  158.             Texts.OpenReader(R, F.text, 0); Texts.ReadElem(R);
  159.             WHILE ~R.eot DO
  160.                 IF R.elem IS Elem THEN pos := Texts.Pos(R); Texts.Delete(F.text, pos-1, pos);
  161.                     Texts.OpenReader(R, F.text, pos-1)
  162.                 END;
  163.                 Texts.ReadElem(R)
  164.             END
  165.         END
  166.     END Unmark;
  167.     PROCEDURE Mark*;
  168.         VAR F: TextFrames.Frame; S: Texts.Scanner; T: Texts.Text;
  169.             text: Texts.Text; beg, end, time, pos, delta: LONGINT; err: INTEGER;
  170.     BEGIN Unmark; F := MarkedFrame(); Oberon.GetSelection(text, beg, end, time); delta := 0;
  171.         IF (F # NIL) & (time >= lastTime) THEN
  172.             lastTime := time; T := F.text; Texts.OpenScanner(S, text, beg);
  173.             LOOP S.line := 0;
  174.                 REPEAT Texts.Scan(S) UNTIL S.eot OR (S.line # 0) OR (S.class = Texts.Int);
  175.                 IF S.eot OR (S.line # 0) THEN EXIT END;
  176.                 pos := S.i;
  177.                 REPEAT Texts.Scan(S) UNTIL S.eot OR (S.line # 0) OR (S.class = Texts.Int);
  178.                 IF S.eot OR (S.line # 0) THEN EXIT END;
  179.                 err := SHORT(S.i); InsertAt(T, pos + delta, err); INC(delta);
  180.                 REPEAT Texts.Scan(S) UNTIL S.eot OR (S.line # 0)
  181.             END
  182.         END
  183.     END Mark;
  184.     PROCEDURE LocateNext*;
  185.         VAR F: TextFrames.Frame; beg, pos: LONGINT; R: Texts.Reader;
  186.     BEGIN F := MarkedFrame();
  187.         IF F # NIL THEN
  188.             IF F.hasCar THEN beg := F.carloc.pos ELSE beg := 0 END;
  189.             Texts.OpenReader(R, F.text, beg);
  190.             REPEAT Texts.ReadElem(R) UNTIL R.eot OR (R.elem IS Elem);
  191.             IF ~R.eot & (R.elem IS Elem) THEN
  192.                 Oberon.PassFocus(Viewers.This(F.X, F.Y)); pos := Texts.Pos(R);
  193.                 Show(F, pos-1); TextFrames.SetCaret(F, pos)
  194.             ELSE TextFrames.RemoveCaret(F)
  195.             END
  196.         END
  197.     END LocateNext;
  198. BEGIN
  199.     font := Fonts.This(ErrFont);
  200.     Texts.OpenWriter(W); lastTime := -1;
  201. END ErrorElems.
  202.     ErrorElems.Mark ^
  203.     ErrorElems.Unmark *
  204.     ErrorElems.LocateNext
  205.